indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ---------------------------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove sample error date + plant
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")#build a function here to make smooth frames so we don't repeat everything in huge loops
#FOR INDIVIDUAL FIGURES ONLY
make_n1_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")
return(smooth_n1)
}
make_n2_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")
return(smooth_n1)
}
#run frames through the functions
wrfa_smooth_n1 <- make_n1_smooth_frame(wrf_a_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n1 <- make_n1_smooth_frame(wrf_b_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n1 <- make_n1_smooth_frame(wrf_c_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfa_smooth_n2 <- make_n2_smooth_frame(wrf_a_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n2 <- make_n2_smooth_frame(wrf_b_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n2 <- make_n2_smooth_frame(wrf_c_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#get max date
maxdate <- max(wrfa_smooth_n1$date)
mindate <- min(wrfa_smooth_n1$date)Build loess smoothing figures figures
#COMBINED FIGURE ONLY
#create smoothing data frames
#n1
smooth_n1 <- only_n1 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#n2
smooth_n2 <- only_n2 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1a <- ggplot(wrfa_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 149)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2a <- ggplot(wrfa_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 149)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1a## `geom_smooth()` using formula 'y ~ x'
fit_n1a## [1] 11.29076 11.33802 11.38474 11.43039 11.47446 11.51647 11.55589 11.59222
## [9] 11.62580 11.65746 11.68745 11.71599 11.74334 11.76974 11.79542 11.81939
## [17] 11.84071 11.85966 11.87650 11.89154 11.90505 11.91731 11.92860 11.93922
## [25] 11.94943 11.95953 11.96979 11.98050 11.99193 11.99748 11.99288 11.98194
## [33] 11.96849 11.95635 11.94932 11.95124 11.95473 11.95090 11.94124 11.92727
## [41] 11.91050 11.89245 11.87462 11.85852 11.84567 11.83757 11.83574 11.84169
## [49] 11.85692 11.88296 11.92063 11.96785 12.02171 12.07933 12.13780 12.19424
## [57] 12.24574 12.30171 12.37189 12.45388 12.54527 12.64367 12.74667 12.85188
## [65] 12.95688 13.05929 13.15670 13.24671 13.32692 13.39492 13.44832 13.50981
## [73] 13.59595 13.69521 13.79601 13.88681 13.95605 13.99217 14.00028 13.99427
## [81] 13.97578 13.94645 13.90791 13.86180 13.80976 13.75343 13.69444 13.63443
## [89] 13.57505 13.51791 13.46468 13.41697 13.34900 13.24382 13.11638 12.98159
## [97] 12.85438 12.74968 12.68242 12.63581 12.58393 12.52804 12.46938 12.40920
## [105] 12.34876 12.28931 12.23209 12.17835 12.12936 12.08635 12.05058 12.02330
## [113] 12.00575 12.00802 12.03344 12.07321 12.11851 12.16052 12.19042 12.19940
## [121] 12.19767 12.20083 12.20815 12.21889 12.23231 12.24767 12.26425 12.28131
## [129] 12.29811 12.31391 12.32798 12.33959 12.34799 12.35245 12.35586 12.36111
## [137] 12.36744 12.37410 12.38034 12.38542 12.38857 12.38906 12.38664 12.38186
## [145] 12.37519 12.36707 12.35797 12.34832 12.33860#n2
extract_n2a## `geom_smooth()` using formula 'y ~ x'
fit_n2a## [1] 10.82954 10.99726 11.16107 11.32036 11.47449 11.62283 11.76475 11.89961
## [9] 12.02783 12.15042 12.26766 12.37983 12.48724 12.59017 12.68890 12.78222
## [17] 12.86897 12.94951 13.02419 13.09337 13.15742 13.21668 13.27153 13.32231
## [25] 13.36939 13.41313 13.45388 13.49200 13.52786 13.55537 13.57049 13.57657
## [33] 13.57696 13.57504 13.57415 13.57765 13.57381 13.55064 13.51116 13.45837
## [41] 13.39528 13.32492 13.25028 13.17438 13.10023 13.03084 12.96922 12.91838
## [49] 12.88133 12.86109 12.84872 12.83445 12.82002 12.80718 12.79768 12.79327
## [57] 12.79569 12.81004 12.83875 12.87956 12.93021 12.98846 13.05206 13.11876
## [65] 13.18629 13.25242 13.31488 13.37143 13.41981 13.45778 13.48308 13.51641
## [73] 13.57301 13.64243 13.71421 13.77791 13.82307 13.83924 13.83117 13.81154
## [81] 13.78181 13.74342 13.69782 13.64645 13.59078 13.53225 13.47230 13.41238
## [89] 13.35395 13.29845 13.24734 13.20205 13.14052 13.04816 12.93760 12.82149
## [97] 12.71249 12.62325 12.56641 12.52949 12.49185 12.45390 12.41603 12.37866
## [105] 12.34219 12.30703 12.27358 12.24225 12.21345 12.18758 12.16505 12.14626
## [113] 12.13162 12.12381 12.12363 12.12868 12.13654 12.14481 12.15107 12.15292
## [121] 12.15351 12.15742 12.16437 12.17411 12.18636 12.20087 12.21735 12.23555
## [129] 12.25520 12.27603 12.29778 12.32018 12.34296 12.36585 12.39021 12.41721
## [137] 12.44637 12.47718 12.50916 12.54180 12.57461 12.60710 12.63914 12.67116
## [145] 12.70345 12.73632 12.77009 12.80504 12.84150#assign fits to a vector
n1_trenda <- fit_n1a
n2_trenda <- fit_n2a
#extract y min and max for each
limits_n1a <- ggplot_build(extract_n1a)$data## `geom_smooth()` using formula 'y ~ x'limits_n1a <- as.data.frame(limits_n1a)
n1_ymina <- limits_n1a$ymin
n1_ymaxa <- limits_n1a$ymax
limits_n2a <- ggplot_build(extract_n2a)$data## `geom_smooth()` using formula 'y ~ x'limits_n2a <- as.data.frame(limits_n2a)
n2_ymina <- limits_n2a$ymin
n2_ymaxa <- limits_n2a$ymax
#reassign dataframes (just to be safe)
work_n1a <- wrfa_smooth_n1
work_n2a<- wrfa_smooth_n1
#fill in missing dates to smooth fits
work_n1a <- work_n1a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1a <- work_n1a$date
work_n2a <- work_n2a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2a <- work_n2a$date
#create a new smooth dataframe to layer
smooth_frame_n1a <- data.frame(date_vec_n1a, n1_trenda, n1_ymina, n1_ymaxa)
smooth_frame_n2a <- data.frame(date_vec_n2a, n2_trenda, n2_ymina, n2_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1a, y = ~n1_trenda,
data = smooth_frame_n1a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a,
'</br> Median Log Copies: ', round(n1_trenda, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2a, y = ~n2_trenda,
data = smooth_frame_n2a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a,
'</br> Median Log Copies: ', round(n2_trenda, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1a, ymin = ~n1_ymina, ymax = ~n1_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n1_ymina, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2a, ymin = ~n2_ymina, ymax = ~n2_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n2_ymina, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_a## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.save(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1b <- ggplot(wrfb_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 149)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2b <- ggplot(wrfb_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 149)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1b## `geom_smooth()` using formula 'y ~ x'
fit_n1b## [1] 11.07925 11.15102 11.22191 11.29114 11.35789 11.42136 11.48076 11.53527
## [9] 11.58571 11.63350 11.67881 11.72180 11.76262 11.80145 11.83843 11.87247
## [17] 11.90258 11.92913 11.95247 11.97297 11.99098 12.00686 12.02096 12.03366
## [25] 12.04529 12.05623 12.06683 12.07745 12.08845 12.09382 12.08952 12.07892
## [33] 12.06535 12.05215 12.04267 12.04025 12.03557 12.01847 11.99107 11.95548
## [41] 11.91384 11.86824 11.82081 11.77367 11.72892 11.68870 11.65510 11.63027
## [49] 11.61629 11.61531 11.62411 11.63745 11.65439 11.67399 11.69530 11.71737
## [57] 11.73927 11.76638 11.80374 11.84985 11.90321 11.96232 12.02569 12.09180
## [65] 12.15917 12.22630 12.29168 12.35382 12.41122 12.46238 12.50580 12.56373
## [73] 12.65131 12.75641 12.86691 12.97067 13.05556 13.10945 13.14475 13.18149
## [81] 13.21891 13.25626 13.29281 13.32779 13.36047 13.39009 13.41592 13.43719
## [89] 13.45317 13.46311 13.46625 13.46186 13.44151 13.40160 13.34866 13.28922
## [97] 13.22979 13.17691 13.13709 13.09938 13.04988 12.99065 12.92377 12.85132
## [105] 12.77537 12.69799 12.62127 12.54727 12.47808 12.41576 12.36240 12.32006
## [113] 12.29082 12.27656 12.27489 12.28144 12.29186 12.30179 12.30687 12.30275
## [121] 12.29370 12.28681 12.28195 12.27901 12.27787 12.27841 12.28051 12.28405
## [129] 12.28890 12.29495 12.30208 12.31017 12.31910 12.32874 12.33966 12.35235
## [137] 12.36662 12.38228 12.39911 12.41692 12.43588 12.45623 12.47790 12.50081
## [145] 12.52489 12.55006 12.57625 12.60216 12.62817#n2
extract_n2b## `geom_smooth()` using formula 'y ~ x'
fit_n2b## [1] 10.73143 10.83893 10.94459 11.04775 11.14777 11.24398 11.33574 11.42240
## [9] 11.50466 11.58373 11.65969 11.73259 11.80251 11.86951 11.93367 11.99394
## [17] 12.04946 12.10059 12.14767 12.19107 12.23114 12.26823 12.30269 12.33489
## [25] 12.36517 12.39389 12.42140 12.44807 12.47423 12.49487 12.50655 12.51200
## [33] 12.51396 12.51518 12.51840 12.52636 12.53060 12.52219 12.50312 12.47541
## [41] 12.44104 12.40203 12.36038 12.31808 12.27714 12.23955 12.20734 12.18248
## [49] 12.16700 12.16288 12.15922 12.14654 12.12901 12.11078 12.09601 12.08886
## [57] 12.09349 12.11000 12.13491 12.16705 12.20523 12.24827 12.29498 12.34418
## [65] 12.39469 12.44531 12.49488 12.54219 12.58608 12.62535 12.65882 12.71298
## [73] 12.80488 12.91915 13.04043 13.15334 13.24253 13.29263 13.31892 13.34642
## [81] 13.37439 13.40210 13.42880 13.45377 13.47625 13.49551 13.51081 13.52141
## [89] 13.52658 13.52557 13.51765 13.50208 13.46697 13.40673 13.33001 13.24545
## [97] 13.16172 13.08747 13.03136 12.98118 12.92017 12.85018 12.77309 12.69074
## [105] 12.60499 12.51769 12.43070 12.34588 12.26508 12.19016 12.12298 12.06538
## [113] 12.01923 11.98374 11.95545 11.93225 11.91201 11.89260 11.87192 11.84782
## [121] 11.82218 11.79830 11.77625 11.75610 11.73792 11.72176 11.70771 11.69583
## [129] 11.68618 11.67884 11.67386 11.67132 11.67129 11.67383 11.67921 11.68741
## [137] 11.69806 11.71079 11.72523 11.74103 11.75836 11.77767 11.79892 11.82207
## [145] 11.84709 11.87394 11.90260 11.93176 11.96177#assign fits to a vector
n1_trendb <- fit_n1b
n2_trendb <- fit_n2b
#extract y min and max for each
limits_n1b <- ggplot_build(extract_n1b)$data## `geom_smooth()` using formula 'y ~ x'limits_n1b <- as.data.frame(limits_n1b)
n1_yminb <- limits_n1b$ymin
n1_ymaxb <- limits_n1b$ymax
limits_n2b <- ggplot_build(extract_n2b)$data## `geom_smooth()` using formula 'y ~ x'limits_n2b <- as.data.frame(limits_n2b)
n2_yminb <- limits_n2b$ymin
n2_ymaxb <- limits_n2b$ymax
#reassign dataframes (just to be safe)
work_n1b <- wrfb_smooth_n1
work_n2b<- wrfb_smooth_n1
#fill in missing dates to smooth fits
work_n1b <- work_n1b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1b <- work_n1b$date
work_n2b <- work_n2b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2b <- work_n2b$date
#create a new smooth dataframe to layer
smooth_frame_n1b <- data.frame(date_vec_n1b, n1_trendb, n1_yminb, n1_ymaxb)
smooth_frame_n2b <- data.frame(date_vec_n2b, n2_trendb, n2_yminb, n2_ymaxb)
#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1b, y = ~n1_trendb,
data = smooth_frame_n1b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b,
'</br> Median Log Copies: ', round(n1_trendb, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2b, y = ~n2_trendb,
data = smooth_frame_n2b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b,
'</br> Median Log Copies: ', round(n2_trendb, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1b, ymin = ~n1_yminb, ymax = ~n1_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n1_yminb, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2b, ymin = ~n2_yminb, ymax = ~n2_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n2_yminb, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth #n1 extract # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1c <- ggplot(wrfc_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 135)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2c <- ggplot(wrfc_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 135)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1c## `geom_smooth()` using formula 'y ~ x'
fit_n1c## [1] 11.08879 11.15815 11.22565 11.29118 11.35465 11.41594 11.47496 11.53160
## [9] 11.58595 11.63817 11.68832 11.73643 11.78253 11.82665 11.86885 11.90915
## [17] 11.94758 11.98420 12.01902 12.05210 12.08346 12.11314 12.14032 12.16430
## [25] 12.18530 12.20355 12.21926 12.23267 12.24400 12.25347 12.26130 12.26772
## [33] 12.27295 12.27721 12.28074 12.28375 12.27862 12.26065 12.23446 12.20466
## [41] 12.17586 12.15268 12.13972 12.13522 12.13406 12.13581 12.14002 12.14626
## [49] 12.15410 12.16310 12.17282 12.18283 12.19269 12.20196 12.21021 12.21701
## [57] 12.22191 12.23331 12.25633 12.28557 12.31566 12.34122 12.35685 12.35719
## [65] 12.34563 12.32946 12.30910 12.28498 12.25751 12.22712 12.19423 12.15926
## [73] 12.12264 12.08479 12.04613 12.00708 11.96807 11.92952 11.88799 11.84034
## [81] 11.78740 11.73001 11.66902 11.60525 11.53955 11.47275 11.40570 11.33922
## [89] 11.27417 11.21138 11.15169 11.09593 11.02156 10.91487 10.78998 10.66098
## [97] 10.54200 10.44713 10.39048 10.36462 10.35181 10.35066 10.35983 10.37793
## [105] 10.40360 10.43547 10.47218 10.51236 10.55463 10.59763 10.64000 10.68036
## [113] 10.71736 10.75509 10.79831 10.84659 10.89950 10.95660 11.01746 11.08166
## [121] 11.14876 11.21833 11.28994 11.36316 11.43756 11.51271 11.59119 11.67221
## [129] 11.75334 11.83600 11.92042 12.00682 12.09543 12.18648 12.28021#n2
extract_n2c## `geom_smooth()` using formula 'y ~ x'
fit_n2c## [1] 11.61834 11.63404 11.64990 11.66551 11.68049 11.69447 11.70705 11.71786
## [9] 11.72705 11.73514 11.74228 11.74863 11.75433 11.75953 11.76440 11.76907
## [17] 11.77370 11.77845 11.78347 11.78890 11.79490 11.80163 11.80731 11.81038
## [25] 11.81130 11.81052 11.80851 11.80572 11.80260 11.79962 11.79723 11.79588
## [33] 11.79604 11.79816 11.80269 11.81010 11.80682 11.78430 11.75051 11.71340
## [41] 11.68095 11.66110 11.66183 11.68705 11.73312 11.79667 11.87434 11.96276
## [49] 12.05856 12.15839 12.25887 12.35664 12.44834 12.53059 12.60004 12.65332
## [57] 12.68706 12.72154 12.77374 12.83531 12.89790 12.95317 12.99278 13.00838
## [65] 13.00020 12.97553 12.93664 12.88578 12.82521 12.75720 12.68400 12.60788
## [73] 12.53110 12.45591 12.38458 12.31937 12.26253 12.21634 12.17114 12.11682
## [81] 12.05493 11.98701 11.91461 11.83928 11.76257 11.68603 11.61119 11.53962
## [89] 11.47285 11.41244 11.35994 11.31689 11.28356 11.25789 11.23794 11.22175
## [97] 11.20738 11.19286 11.17625 11.16028 11.14858 11.14057 11.13568 11.13333
## [105] 11.13295 11.13395 11.13577 11.13781 11.13952 11.14030 11.13959 11.13680
## [113] 11.13137 11.12359 11.11449 11.10455 11.09424 11.08404 11.07441 11.06585
## [121] 11.05883 11.05381 11.05129 11.05173 11.05561 11.06341 11.07331 11.08490
## [129] 11.09941 11.11628 11.13536 11.15648 11.17950 11.20427 11.23063#assign fits to a vector
n1_trendc <- fit_n1c
n2_trendc <- fit_n2c
#extract y min and max for each
limits_n1c <- ggplot_build(extract_n1c)$data## `geom_smooth()` using formula 'y ~ x'limits_n1c <- as.data.frame(limits_n1c)
n1_yminc <- limits_n1c$ymin
n1_ymaxc <- limits_n1c$ymax
limits_n2c <- ggplot_build(extract_n2c)$data## `geom_smooth()` using formula 'y ~ x'limits_n2c <- as.data.frame(limits_n2c)
n2_yminc <- limits_n2c$ymin
n2_ymaxc <- limits_n2c$ymax
#reassign dataframes (just to be safe)
work_n1c <- wrfc_smooth_n1
work_n2c <- wrfc_smooth_n1
#fill in missing dates to smooth fits
work_n1c <- work_n1c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1c <- work_n1c$date
work_n2c <- work_n2c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2c <- work_n2c$date
#create a new smooth dataframe to layer
smooth_frame_n1c <- data.frame(date_vec_n1c, n1_trendc, n1_yminc, n1_ymaxc)
smooth_frame_n2c <- data.frame(date_vec_n2c, n2_trendc, n2_yminc, n2_ymaxc)
#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1c, y = ~n1_trendc,
data = smooth_frame_n1c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c,
'</br> Median Log Copies: ', round(n1_trendc, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2c, y = ~n2_trendc,
data = smooth_frame_n2c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c,
'</br> Median Log Copies: ', round(n2_trendc, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1c, ymin = ~n1_yminc, ymax = ~n1_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n1_yminc, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2c, ymin = ~n2_yminc, ymax = ~n2_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n2_yminc, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(smooth_frame_n1a, file = "./plotly_objs/smooth_frame_n1a.rda")
save(smooth_frame_n2a, file = "./plotly_objs/smooth_frame_n2a.rda")
save(smooth_frame_n1b, file = "./plotly_objs/smooth_frame_n1b.rda")
save(smooth_frame_n2b, file = "./plotly_objs/smooth_frame_n2b.rda")
save(smooth_frame_n1c, file = "./plotly_objs/smooth_frame_n1c.rda")
save(smooth_frame_n2c, file = "./plotly_objs/smooth_frame_n2c.rda")save(date_vec_n1a, file = "./plotly_objs/date_vec_n1a.rda")
save(date_vec_n2a, file = "./plotly_objs/date_vec_n2a.rda")
save(date_vec_n1b, file = "./plotly_objs/date_vec_n1b.rda")
save(date_vec_n2b, file = "./plotly_objs/date_vec_n2b.rda")
save(date_vec_n1c, file = "./plotly_objs/date_vec_n1c.rda")
save(date_vec_n2c, file = "./plotly_objs/date_vec_n2c.rda")save(n1_ymina, file = "./plotly_objs/n1_ymina.rda")
save(n1_ymaxa, file = "./plotly_objs/n1_ymaxa.rda")
save(n2_ymina, file = "./plotly_objs/n2_ymina.rda")
save(n2_ymaxa, file = "./plotly_objs/n2_ymaxa.rda")
save(n1_yminb, file = "./plotly_objs/n1_yminb.rda")
save(n1_ymaxb, file = "./plotly_objs/n1_ymaxb.rda")
save(n2_yminb, file = "./plotly_objs/n2_yminb.rda")
save(n2_ymaxb, file = "./plotly_objs/n2_ymaxb.rda")
save(n1_yminc, file = "./plotly_objs/n1_yminc.rda")
save(n1_ymaxc, file = "./plotly_objs/n1_ymaxc.rda")
save(n2_yminc, file = "./plotly_objs/n2_yminc.rda")
save(n2_ymaxc, file = "./plotly_objs/n2_ymaxc.rda")